home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Appls / dial.f < prev    next >
Encoding:
FORTH Source  |  1991-04-24  |  4.2 KB  |  198 lines
  1. \ Fast Dial Telephone Utility
  2. \ Uses a Hayes Modem connected to the serial port.
  3. \
  4. \ This program reads a file containing names and numbers
  5. \ looking for a match. If it matches then it dials the number.
  6. \
  7. \ Author: Phil Burk
  8. \ Copyright 1991 Phil Burk
  9. \ All Rights Reserved.
  10.  
  11. include? dolines ju:dolines
  12.  
  13. ANEW TASK-DIAL.F
  14.  
  15. create PERSON-NAME 32 allot    \ place to hold name
  16. create &0D $ 0D c, 0 c,  \ fwrite requires a string in memory
  17.  
  18. variable DIAL-DONE
  19. variable SER-FILEID
  20.  
  21. : DELAY() ( ticks -- , wait )
  22.     callvoid dos_lib delay
  23. ;
  24.  
  25. : DIAL.HELP  ( -- )
  26.     cr
  27.     ." Usage:" cr
  28.     ."   to dial by name:    DIAL name {filename}" cr
  29.     ."   to dial by number:  DIAL ###-####" cr
  30.     ."   to add name:        DIAL ADD name ###-#### {filename}" cr
  31.     cr
  32.     ." Default filename is S:PHONELIST" cr
  33.     ." File should contain lines with:   name ###-####" cr
  34.     ." Use Hayes compatible modem." cr
  35.     ." Set Serial Preferences appropriately." cr
  36.     ." For optional filenames make an alias for speed:" cr
  37.     ."     ALIAS DL DIAL [] DH0:PHONELIST" cr
  38. ;
  39.  
  40. : SER.TYPE ( addr count -- , echo string and send it to modem )
  41.     2dup type
  42.     ser-fileid @ -rot fwrite drop \ no error check!
  43. ;
  44.  
  45. : SER.CR ( -- , carriage return )
  46.     cr
  47.     &0d 1 ser.type
  48. ;
  49.  
  50. : (DIAL.STRING)  ( addr count -- , dial number in string )
  51.     ser.cr
  52.     20 delay()
  53.     " AT DT " count ser.type  ( dial using touch tone )
  54.     ser.type
  55.     " ;" count ser.type  \ ';' so modem returns to command mode
  56.     ser.cr
  57.     f:3 ." Pick up phone!" cr f:1
  58.     8 60 * delay()  \ delay a few seconds , may need to be extended
  59.     " AT H" count ser.type ser.cr  ( hang up modem so phone is not stuck )
  60.     ." Modem disconnected." cr
  61. ;
  62.  
  63. : DIAL.STRING  ( addr count -- , dial number in string )
  64.     " SER:" $fopen ?dup  ( open serial port as file )
  65.     IF
  66.         ser-fileid !
  67.         (dial.string)
  68.         ser-fileid @ fclose
  69.     ELSE ." Serial port could not be opened!" cr 2drop
  70.     THEN
  71. ;
  72.         
  73. : DIAL.LINE?  ( $line -- , phone if match at beginning of line )
  74.     dup c@
  75.     person-name c@ >  ( line longer then name )
  76.     IF
  77.         dup 1+ person-name count swap text=?  ( does it match )
  78.         IF
  79.             dial-done @  ( have we already dialed )
  80.             IF
  81.                 ." Duplicate entries!" cr
  82.             ELSE
  83.                 ( skip over name to number )
  84.                 dup count bl skip bl scan
  85.                 dial.string  dial-done on
  86.             THEN
  87.         THEN
  88.     THEN
  89.     drop
  90. ;
  91.  
  92. : CHECK.NUMBER  ( $string -- flag , OK if all digits or - or (  or )
  93.     spare on
  94.     count 0
  95.     DO
  96.         dup i + c@ ( get char )
  97.         dup ascii 0 ascii 9 within? not
  98.         IF
  99.             dup ascii ( = not
  100.             IF
  101.                 dup ascii ) = not
  102.                 IF
  103.                     dup ascii - = not
  104.                     IF
  105.                         drop spare off LEAVE
  106.                     THEN
  107.                 THEN
  108.             THEN
  109.         THEN
  110.         drop
  111.     LOOP
  112.     drop
  113.     spare @
  114. ;
  115.  
  116. : GET.FILENAME  ( {filename} -- )
  117.     fileword dup c@ 0=
  118.     IF drop " S:PHONELIST"
  119.     THEN
  120. ;
  121.  
  122. : (DIAL)  ( <filename> -- , dial name in person-name )
  123.     ' noop is doline.error
  124.     ' dial.line? is doline
  125.     dial-done off
  126.     get.filename $dolines
  127.     dial-done @ 0=
  128.     IF
  129.         f:3 cr ." Could not find "
  130.         person-name $type
  131.         ."  in phone number file." cr f:1
  132.         ." For help, enter: DIAL ?" cr
  133.     THEN
  134. ;
  135.  
  136. : FAPPEND  ( fileid addr count -- count' , append to end of file )
  137.     2 pick 0 offset_end fseek drop
  138.     fwrite
  139. ;
  140.     
  141. : ADD.NAME&NUMBER ( <name> <number> <filename> -- )
  142. \ add person-name and number to file
  143. \ concatenate name and number
  144.     bl lword pad $move
  145.     "   " count pad $append
  146.     bl word count pad $append
  147. \
  148. \ APPEND to file
  149.     get.filename dup $fopen dup 0=
  150.     IF    ( -- $name 0 )
  151.         drop NEW dup $fopen dup 0=  ( start a new file )
  152.         IF    ( -- $name 0 )
  153.             2drop
  154.             f:3 ." Could not open file!" f:1 cr
  155.             ." For help, enter: DIAL ?" cr
  156.             RETURN
  157.         THEN
  158.         f:3 cr ." New file started called: " over $type cr f:1
  159.     THEN
  160.     ( -- $name fid )
  161.     dup pad count fappend drop
  162.     dup EOL femit
  163.     fclose
  164.     cr pad $type ."           added to " $type cr
  165. ;
  166.  
  167. : DIAL ( <person> <filename> -- , phone person )
  168.     >newline
  169.     ." Dial - Copyright Phil Burk 1991, written using JForth" cr
  170.     ." Dial may be freely redistributed for non-commercial use." cr
  171.     ." Dial is SHAREWARE! If you like it, please send $10.00 to:" cr
  172.     ."   Phil Burk, PO Box 151051, San Rafael, CA, 94915-1051" cr
  173.     bl word  ( get person's name )
  174.     dup c@ 0=
  175.     IF
  176.         dial.help
  177.     ELSE
  178.         person-name $move
  179.         person-name check.number
  180.         IF
  181.             person-name count dial.string
  182.         ELSE
  183.             person-name dup c@ 1+ " ADD" text=?
  184.             IF
  185.                 add.name&number
  186.             ELSE
  187.                 person-name dup c@ 1+ " ?" text=?
  188.                 IF
  189.                     dial.help
  190.                 ELSE
  191.                     (dial)
  192.                 THEN
  193.             THEN
  194.         THEN
  195.     THEN
  196. ;
  197.  
  198.